home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
VISUALBA
/
VIEWMEM.ZIP
/
VIEWMEM.BAS
< prev
next >
Wrap
BASIC Source File
|
1994-02-19
|
10KB
|
383 lines
'Viewmem V1.0 - Window into Memory
'PowerBASIC 3.0 Source Code
'(C) Copyright 1993 by Tim Gerchmez
'All Rights Reserved.
'This program is freeware. It may be freely
'copied and distributed, but I retain the copyright.
'Questions or comments can be addressed to:
'Tim Gerchmez, 12648 S.E. 81st Pl. Renton, WA 98056
$COMPILE EXE
shared clr%, bckg%, statclr%, statbckg%,satr??
shared segment??,offset??,aas%,satr1??,satr2??
shared scrnarray??()
def fnmyhex$(value??)=right$("000"+hex$(value??),4)
def fnshorthex$(value?)=right$("0"+hex$(value?),2)
dim absolute scrnarray??(1:2000) at vidseg&
defcols:
if vidseg&=&hb800 then
clr%=14:bckg%=0
statclr%=15:statbckg%=1
hlclr%=15
else
clr%=7:bckg%=0
statclr%=0:statbckg%=7
hlclr%=15
end if
startpoint:
satr??=(16*bckg%+clr%)*256
color clr%,bckg%:cls:call statuslines
tloop:
call doscreen
a$=inkey$:if a$="" then goto tloop
if a$=chr$(27) then color 7,0:cls:end
if a$=chr$(0)+chr$(80) then
incr offset??,80
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(72) then
decr offset??,80
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(77) then
incr offset??,1
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(75) then
decr offset??,1
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(71) and offset??<>0 then
offset??=0
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(71) then
segment??=0
offset??=0
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(79) and offset??<>63696 then
offset??=&HF8D0
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(79) then
segment??=&HF000
offset??=&HF8D0
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(81) then
incr offset??,1840
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(73) then
decr offset??,1840
call statuslines
goto tloop
end if
if a$="+" or a$="=" then
incr segment??,&h1000
call statuslines
goto tloop
end if
if a$="-" or a$="_" then
decr segment??,&h1000
call statuslines
goto tloop
end if
if lcase$(a$)="j" then
call clear25
call capson
print "Jump To (XXXX) OR (XXXX:XXXX): ";
call lineinput(9,ja$)
if len(ja$)=4 then
offset??=hex2dec&(ja$)
call statuslines
call capsoff
goto tloop
end if
if len(ja$)<>9 then call capsoff:call statuslines:goto tloop
ha$=left$(ja$,4):hb$=right$(ja$,4)
segment??=hex2dec&(ha$)
offset??=hex2dec&(hb$)
call statuslines
call capsoff
goto tloop
end if
if lcase$(a$)="a" then
aas%=1-aas%
call statuslines
goto tloop
end if
if lcase$(a$)="d" then
call clear25
print "Dump to Disk - Filename: ";
call lineinput(48,ln$)
if ln$="" then call statuslines:goto tloop
on error goto diskerr
open "o",#1,ln$
reg 1,&h40*256:reg 2,fileattr(1,2)
q&=65536-offset??:if q&>65535 then q&=65535
reg 3,q&:reg 4,offset??:reg 8,segment??
call interrupt(&h21)
close #1
call statuslines:goto tloop
end if
if lcase$(a$)="f" then
casesens%=1
call clear25
print "Find (Case-Sensitive): ";
goto mainsearchpoint
end if
if lcase$(a$)="s" then
casesens%=0
call clear25
print "Search for: ";
mainsearchpoint:
call lineinput(48,ln$):if ln$="" then call statuslines:goto tloop
if casesens%=0 then ln$=ucase$(ln$)
call clear25:print "Searching... ";:locate,,0
def seg = segment??
locate 25,14:print fnmyhex$(segment??);":";
for ofst??=offset?? to (&hffff-len(ln$))
if inkey$=chr$(27) then
def seg
call statuslines
goto tloop
end if
locate 25,19:print fnmyhex$(ofst??);
s$=""
for t%=0 to len(ln$)-1
s$=s$+chr$(peek(ofst??+t%))
next t%
if casesens%=0 then s$=ucase$(s$)
if s$=ln$ then
lastofs??=ofst??
offset??=ofst??
call doscreen
call statuslines
call clear25:print "FOUND ";chr$(34);ln$;chr$(34);
beep
def seg
while inkey$<>"":wend
sleep
a$=inkey$
call statuslines
goto tloop
end if
next ofst??
def seg
call clear25
beep
print chr$(34);ln$;chr$(34);" Not Found.";
while inkey$<>"":wend
def seg
sleep
a$=inkey$
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(59) then
color statclr%,statbckg%:cls
locate 2,25:print "ViewMem Core Memory Utility"
locate 3,25:print "---------------------------"
locate 4,22:print "(C) Copyright 1993 by Tim Gerchmez"
locate 5,29:print "All Rights Reserved."
locate 8,4:print "F1 = Help F2 = Character Color F3 = Background Color"
locate 9,4:print "F4 = Status Line Foregd. F5 = Status Line Backgd. F6 = Default Colors "
locate 11,4:print "Crsr Up = Offset - 80 Crsr Lft = Offset - 1 PgUp = Offset - 1840"
locate 12,4:print "Crsr Dwn = Offset + 80 Crsr Right = Offset + 1 PgDwn= Offset + 1840"
locate 14,4:print "Home = Start of Segment / First Segment + = Forward One Segment"
locate 15,4:print "End = End of Segment / Last Segment - = Backward One Segment"
locate 17,4:print "A = Toggle All/ASCII display D = Dump Segment to Disk"
locate 18,4:print "F = Find (Case-Sensitive) J = Jump to Offset or Segment/Offset"
locate 19,4:print "S = Search (Not Case-Sensitive)"
locate 21,4:print "ESC = Exit Memory View"
while inkey$<>"":wend
sleep
a$=inkey$
call statuslines
goto tloop
end if
if a$=chr$(0)+chr$(60) then
incr clr%:if clr%=bckg% then incr clr%
if clr%>15 then clr%=0:if clr%=bckg% then incr clr%
goto startpoint
end if
if a$=chr$(0)+chr$(61) then
incr bckg%:if bckg%=clr% then incr bckg%
if bckg%>7 then bckg%=0:if bckg%=clr% then incr bckg%
goto startpoint
end if
if a$=chr$(0)+chr$(62) then
incr statclr%:if statclr%=statbckg% then incr statclr%
if statclr%>15 then statclr%=0:if statclr%=statbckg% then incr statclr%
goto startpoint
end if
if a$=chr$(0)+chr$(63) then
incr statbckg%:if statbckg%=statclr% then incr statbckg%
if statbckg%>7 then statbckg%=0:if statbckg%=statclr% then incr statbckg%
goto startpoint
end if
if a$=chr$(0)+chr$(64) then goto defcols
goto tloop
end
diskerr:
call clear25
beep
print "Disk Error ... Press a Key";
close #1
while inkey$<>"":wend
sleep
a$=inkey$
call statuslines
resume tloop
'------------------------------------------------------------------------------
SUB capsoff
'Turns Capslock off.
'Example: CALL capsoff
DEF SEG = &H40
POKE &H17, PEEK(&H17) AND (&HFF - &H40)
DEF SEG
END SUB
'------------------------------------------------------------------------------
SUB capson
'Turns Capslock on.
'Example: CALL capson
DEF SEG = &H40
POKE &H17, PEEK(&H17) OR &H40
DEF SEG
END SUB
'------------------------------------------------------------------------------
sub clear25
color statclr%,statbckg%
locate 25,1,0:print space$(79);" ";
locate 25,1,0
end sub
'------------------------------------------------------------------------------
sub doscreen
def seg = segment??
sadr??=offset??
for t??=81 to 1920
q?=peek(sadr??)
if aas%=1 then if q?<32 or q?>126 then q?=32
scrnarray??(t??)=satr?? + q?
incr sadr??
next t%
end sub
'------------------------------------------------------------------------------
FUNCTION hex2dec& (hxd$)
'Translates a hexidecimal number in a string into a
'positive decimal number. Hex digits can be lower or
'uppercase (won't affect the result). Up to 7 Hexadecimal
'digits are allowed.
'Example: PRINT hex2dec& ("&H2A7")
hx$ = UCASE$(hxd$): num& = 0: h$ = "0123456789ABCDEF"
sm = 1: x& = 0
IF LEFT$(hx$, 2) = "&H" THEN hx$ = RIGHT$(hx$, LEN(hx$) - 2)
FOR T% = LEN(hx$) TO 1 STEP -1
x$ = MID$(hx$, T%, 1)
FOR u% = 1 TO LEN(h$)
IF x$ = MID$(h$, u%, 1) THEN EXIT FOR
NEXT u%
x% = u% - 1
x& = x& + (x% * sm): sm = sm * 16
NEXT T%
hex2dec& = x&
END FUNCTION
'------------------------------------------------------------------------------
SUB lineinput (maxlen%, ln$)
'Allows input of a line of text at a certain screen position and a given
'maximum length.
'ESC will end the routine with ln$=""
'ENTER ends routine normally.
'Example: CALL lineinput(1,1,10,ln$)